10 ' lissagw.bas - FREEWARE 2005
20 GOTO 60 ' begin
30 SAVE"lissagw.bas",A:LIST-40
40 GOTO 610 ' wait for key
50 GOTO 640 ' centered text
60 SCREEN 9:CLS:PI=4*ATN(1):DEFSTR M,Q:Q=MKI$(0)
70 DIM X(7,13),Y(7,13),EM(7),M(17),EX(100),EY(100)
80 EM(1)=13:EM(2)=7:EM(3)=7:EM(4)=6:EM(5)=2:EM(6)=2:EM(7)=5
90 M(1)="LISSAJOUS Figures idea from Hans Lauwerier"
100 M(2)="GWBASIC by Eric Tchong"
110 M(3)=" <1> Lissajous figure 1"
120 M(4)=" <2> Lissajous figure 2"
130 M(5)=" <3> Lissajous figure 3"
140 M(6)=" <4> Cats              "
150 M(7)=" <5> Fourier           "
160 M(8)=" <6> Web               "
170 M(9)=" <7> Diagonals         "
180 M(10)=" <8> Star many angles  "
190 M(11)=" <9> Astroide          "
200 M(12)="<10> Cycloid          "
210 M(13)="<11> Turnline         "
220 M(14)="<12> Wirling square   "
230 M(15)="Choose 1..10   -1 = stop program"
240 M(16)="Press any key for menu..."
250 FOR I=1 TO 15
260  GOSUB 50
270  IF I=2 OR I=14 THEN PRINT
280 NEXT
290 LOCATE 18,30:INPUT CH:IF CH=-1 THEN 460
300 IF CH<1 OR CH>12 THEN 290
310 ON CH GOTO 330,480,670,790,1010,1150,1250,1370,1490,1560,1710,1830
320 ' first lissajous
330 CLS:WINDOW (-2,-1.5)-(2,1.5)
340 A=4/3:EM=15:N=22:F=.5
350 S=N/EM:F=2*PI*F:H=.005:T=0
360 LSET Q=MKI$(0)
370 WHILE CVI(Q)=0
380  X=A*SIN(T)
390  Y=SIN(S*T+F)
400  PSET (X, Y)
410  MID$(Q,1)=INKEY$:IF CVI(Q) THEN 430
420  T=T+H:IF T>2*EM*PI THEN 450
430 WEND
440 GOTO 360
450 LOCATE 23,1:I=16:GOSUB 50:GOSUB 40:CLS:GOTO 250
460 SCREEN 0,0,0:CLS:END
470 ' second lissajous
480 CLS:WINDOW (-2,-1.5)-(2,1.5)
490 A=1:B=.5:S=2.45:T=0:H=.01
500 LINE (-A-B-.1,-1.1)-(A+B+.1,1.1),,B
510 LSET Q=MKI$(0)
520 WHILE CVI(Q)=0
530  X=A*COS(T)+B*COS(S*T)
540  Y=SIN(T)
550  IF T=0 THEN PSET (X,Y) ELSE LINE -(X,Y)
560  MID$(Q,1)=INKEY$:IF CVI(Q) THEN 580
570  T=T+H:IF T>315 THEN 450
580 WEND
590 GOTO 510
600 ' wait for key
610 LSET Q=MKI$(0)
620 WHILE CVI(Q)=0:MID$(Q,1)=INKEY$:WEND:RETURN
630 ' centered text
640 X=(80-LEN(M(I)))/2
650 PRINT TAB(X) M(I):RETURN
660 ' third lissajous
670 CLS:WINDOW (-3.2,-2.4)-(3.2,2.4)
680 A=11/7:R=.6:H=.02:T=0
690 LSET Q=MKI$(0)
700 WHILE CVI(Q)=0
710  X=COS(T):Y=SIN(T)
720  X1=X+R*COS(A*T):Y1=Y+R*SIN(A*T)
730  PSET (X1,Y1),14
740  MID$(Q,1)=INKEY$:IF CVI(Q) THEN 760
750  T=T+H:IF T>315 THEN 450
760 WEND
770 GOTO 690
780 ' cats
790 CLS:WINDOW (6,6)-(114,87):RESTORE
800 FOR I=1 TO 7:FOR J=1 TO EM(I)
810  READ X(I,J),Y(I,J)
820 NEXT:NEXT
830 FOR I=1 TO 6
840  FOR J=1 TO 8
850   FOR K=1 TO 7
860    PSET (12*J+X(K,1),12*I+Y(K,1))
870    FOR L=2 TO EM(K)
880     LINE -(12*J+X(K,L),12*I+Y(K,L))
890    NEXT
900   NEXT
910  NEXT
920 NEXT
930 GOSUB 40:CLS:GOTO 250
940 DATA 0,0,-1,4,0,8,0,12,3,9,9,9,12
950 DATA 12,12,8,11,4,12,0,9,-3,3,-3,0,0
960 DATA 2,2,1.5,3,2.5,4,3.5,4,4,3.5,4,2,2,2
970 DATA 8,2,8,3.5,8.5,4,9.5,4,10.5,3,10,2,8,2
980 DATA 2,1,10,1,6,.6,6,-.5,6,.6,2,1,3,4,3,2.5,9,4,9,2.5
990 DATA 2.5,-.5,4,-1.5,6,-1,8,-1.5,9.5,-.5
1000 ' fourier
1010 CLS:WINDOW (-8,-3)-(8,3)
1020 FOR I=1 TO 8:B(I)=1/I:NEXT
1030 JMAX=1000
1040 LINE (-2*PI,0)-(2*PI,0)
1050 FOR J=0 TO JMAX
1060  X=-2*PI+4*PI*J/JMAX
1070  S=0
1080  FOR K=1 TO 8
1090   S=S+B(K)*SIN(K*X)
1100  NEXT
1110  IF J=0 THEN PSET (X,S) ELSE LINE -(X,S)
1120 NEXT
1130 GOTO 450
1140 ' web
1150 CLS:WINDOW (-.2,-1.2)-(1.2,1.2):N=16
1160 FOR I=0 TO N
1170  FOR J=0 TO N
1180   C=ABS(I-J)
1190   X1=I/N:Y1=1:X2=J/N:Y2=-1
1200   IF C MOD 2 = 1 THEN LINE (X1,Y1)-(X2,Y2),C
1210  NEXT
1220 NEXT
1230 GOTO 930
1240 ' diagonals
1250 CLS:WINDOW (-1.6,-1.2)-(1.6,1.2):N=17
1260 FOR K=1 TO N
1270  EX(K)=COS(2*K*PI/N)
1280  EY(K)=SIN(2*K*PI/N)
1290 NEXT
1300 FOR I=1 TO N
1310  FOR J=1 TO I-1
1320   LINE (EX(I),EY(I))-(EX(J),EY(J))
1330  NEXT
1340 NEXT
1350 GOTO 930
1360 ' star many angles
1370 CLS:WINDOW (-1.6,-1.2)-(1.6,1.2)
1380 N=33:P=11:EQ=17
1390 FOR K=0 TO N-1
1400  EX(K)=COS(2*K*PI/N)
1410  EY(K)=SIN(2*K*PI/N)
1420 NEXT
1430 FOR I=P TO EQ:FOR J=0 TO N-1
1440  K=(I+J) MOD N
1450  LINE (EX(J),EY(J))-(EX(K),EY(K))
1460 NEXT:NEXT
1470 GOTO 930
1480 ' astroide
1490 CLS:WINDOW (-1.6,-1.2)-(1.6,1.2):N=64
1500 FOR I=0 TO N-1
1510  T=2*PI*I/N
1520  LINE (COS(T),0)-(0,SIN(T))
1530 NEXT
1540 GOTO 930
1550 ' cycloid
1560 CLS:EPS=.0001:WINDOW (-1.6,-1.2)-(1.6,1.2)
1570 K=1:L=3:A=.8:N=80:LINE (-1,-1)-(1,1),,B
1580 FOR J=0 TO N
1590  T=2*PI*L*J/N
1600  A1=COS(T):B1=SIN(T)
1610  A2=COS(K*T/L):B2=SIN(K*T/L+EPS)
1620  P=B1-B2:EQ=A1-A2:R=(A1*B2-A2*B1)*A:S=1
1630  IF ABS(EQ-R)<=ABS(P) THEN U(S)=(EQ-R)/P:V(S)=-1:S=S+1
1640  IF ABS(EQ+R)<=ABS(P) THEN U(S)=-(EQ+R)/P:V(S)=1:S=S+1
1650  IF ABS(P-R)<ABS(EQ) THEN U(S)=-1:V(S)=(P-R)/EQ:S=S+1
1660  IF ABS(P+R)<ABS(EQ) THEN U(S)=1:V(S)=-(P+R)/EQ:S=S+1
1670  LINE (U(1),V(1))-(U(2),V(2))
1680 NEXT
1690 GOTO 930
1700 ' turnline
1710 CLS:WINDOW (-2,-1.5)-(2,1.5)
1720 A=.4:B=6:R=.6:N=256:EM=3
1730 FOR K=0 TO EM-1
1740  FOR L=0 TO N-1
1750   RK=R^K:T1=2*L*PI/N:T2=B*L*PI/N
1760   X0=RK*COS(T1):Y0=RK*SIN(T1)
1770   X1=A*RK*COS(T2):Y1=A*RK*SIN(T2)
1780   LINE (X0-X1,Y0-Y1)-(X0+X1,Y0+Y1)
1790  NEXT 
1800 NEXT
1810 GOTO 930
1820 ' wirling square
1830 CLS:WINDOW (-1.6,-1.2)-(1.6,1.2):P=4:B=.05
1840 A=PI*(1-2/P):C=SIN(A)/(SIN(B)+SIN(A+B))
1850 FOR K=0 TO P
1860  T=(2*K+1)*PI/P
1870  EX(K)=SIN(T):EY(K)=COS(T)
1880 NEXT
1890 FOR N=1 TO 64
1900  PSET (EX(0),EY(0))
1910   FOR L=1 TO P
1920    LINE -(EX(L),EY(L))
1930   NEXT
1940   FOR EM=0 TO P
1950    Z=EX(EM)
1960    EX(EM)=(EX(EM)*COS(B)-EY(EM)*SIN(B))*C
1970    EY(EM)=(Z*SIN(B)+EY(EM)*COS(B))*C
1980   NEXT
1990 NEXT
2000 GOTO 450
